home *** CD-ROM | disk | FTP | other *** search
/ Mega Guia 2004 June / Mega Guia: 2004-06.iso / _files / free / myalbum / ES / myalbumsetup.exe / {app} / AutoTab.vbs next >
Text File  |  2003-02-16  |  2KB  |  56 lines
  1. ' ------------------------------------------------------------------------------------
  2. '         Create tabs for an album
  3. '
  4. ' This script analyses the current album and create a keyword tab for
  5. ' every folder a picture is found in.
  6. ' ------------------------------------------------------------------------------------
  7.  
  8. Option Explicit
  9.  
  10. app.ClearTrace
  11.  
  12. dim alb
  13. set alb = app.GetCurrentAlbum
  14.  
  15. dim s, k
  16. s = "This script will create tabs based on the picture folders." & chr(13) & chr(13)
  17. s = s & "This album will be used: " & alb.sAlbumTitle & " (" & alb.FullName & ")" & chr(13)
  18. s = s & "Click Yes to proceed" & chr(13)
  19. s = s & "Click No  to abort"
  20. k = MsgBox( s, vbYesNo, "AutoTaber" )
  21.  
  22. if k = vbYes then
  23.  
  24.   dim i, j, kw, pos1, pos2, folder
  25.  
  26.   ' Process each picture
  27.   Dim nbPic
  28.   nbPic = alb.nbPicture
  29.   app.Trace "Pictures to process: " & nbPic, -1, TRACE_INFORMATION
  30.  
  31.   dim pic, pic2, filename
  32.   for i = 0 to nbPic-1
  33.     Set pic = alb.GetPicture(i)
  34.  
  35.     ' Get the relative path of the picture
  36.     filename = alb.ExpandMacro( pic, "%RP" )
  37.     app.Trace "Processing picture #" & i+1 & " " & filename
  38.  
  39.     pos1 = InstrRev( filename, "\" )
  40.     if pos1 > 0 then
  41.       pos2 = InstrRev( filename, "\", pos1-1 )
  42.       if pos2 <> 0 then
  43.         folder = mid( filename, pos2+1, pos1-pos2-1 )
  44.     set kw = alb.addKeyword( folder )
  45.         kw.bIsTab = True
  46.         pic.SetKeyword folder, True
  47.       end if
  48.     end if
  49.  
  50.   next
  51.  
  52.   alb.Redraw
  53.   app.Trace "Done !", -1, TRACE_GREENDOT
  54.  
  55. end if
  56.